home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / c / jpl_c.zip / TANH.C < prev    next >
Text File  |  1986-05-18  |  2KB  |  60 lines
  1. /* 1.0  04-27-84 */
  2. /************************************************************************
  3.  *            Robert C. Tausworthe                *
  4.  *            Jet Propulsion Laboratory            *
  5.  *            Pasadena, CA 91009        1984        *
  6.  ************************************************************************
  7.  *    Programmmed using the algorithms given in:
  8.  *
  9.  *    Coty, William J., Jr., and Waite, William, SOFTWARE MANUAL FOR
  10.  *    THE ELEMENTARY FUNCTIONS, Prentice-Hall Series in Computational
  11.  *    Mathematics, Prentice-Hall, Inc., Inglewood Cliffs, NJ, 1980,
  12.  *    pp. 239-255.
  13.  *
  14.  *----------------------------------------------------------------------*/
  15.  
  16. #include "defs.h"
  17. #include "stdtyp.h"
  18. #include "errno.h"
  19. #include "mathtyp.h"
  20. #include "mathcons.h"
  21.  
  22. /*----------------------------------------------------------------------*/
  23.  
  24. #define LN3ov2    0.54930614433405484570
  25.  
  26. #define P0     -0.16134119023996228053e+4
  27. #define P1     -0.99225929672236083313e+2
  28. #define P2     -0.96437492777225469787e+0
  29. #define gP(g)     (((P2*g P1)*g P0)*g)
  30.  
  31. #define Q0     +0.48402357071988688686e+4
  32. #define Q1     +0.22337720718962312926e+4
  33. #define Q2     +0.11274474380534949335e+3
  34. #define Q3    +1.0
  35. #define Q(g)     (((g Q2)*g Q1)*g Q0)
  36.  
  37. /*\p*********************************************************************/
  38.     double
  39. tanh(x)            /* return hyperbolic tangent of x        */
  40.  
  41. /*----------------------------------------------------------------------*/
  42. double x;
  43. {
  44.     double f,g,r;
  45.     
  46.     if ((f = ABS(x)) > TANHXBIG)
  47.         r = 1.0;
  48.     else if (f > LN3ov2)
  49.         r = ldexp(0.5 - 1.0 / (exp(ldexp(f, 1)) + 1.0), 1);
  50.     else if (f < FADEOUT)
  51.         r = f;
  52.     else
  53.     {    g = f * f;
  54.         r = f + f*
  55.             (gP(g)
  56.             /Q(g));
  57.     }
  58.     return (x < 0.0 ? -r : r);
  59. }
  60.